;;; ________________________________________________________________
;;; 
;;; 	  	      Transformation Kit V3-2
;;; 		      -----------------------
;;; 
;;; 			   Masaru Tomita
;;; 		   Center for Machine Translation
;;; 		     Carnegie-Mellon University
;;; 
;;; 	_______________________________________________________
;;;     The following two files are required:
;;; 		util.lisp
;;; 		pseudo-unify.lisp
;;; 
;;;     User's manual for Generation Kit V3-2 is available in
;;;       /../nl/usr/mt/Paper/trfkit/trfkit.mss (.PS)
;;; 	_______________________________________________________
;;; 
;;; 
;;; ________________________________________________________________

;;; ________________________________________________________________
;;; 
;;;  HISTORY
;;; 
;;; 23-Feb-88	Masaru Tomita (mt) at Carnegie-Mellon University
;;; 	Created.
;;; ________________________________________________________________


;;; ________________________________________________________________
;;; 
;;; 	Global Variable DECLARATION and INITIALIZATION
;;; ________________________________________________________________


;;; Constituent list
;;; 
(defconstant CONSTIT-LIST 
	'(x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10
	  x11 x12 x13 x14 x15 x16 x17 x18 x19 x20
	  x21 x22 x23 x24 x25 x26 x27 x28 x29 x30
	  x31 x32 x33 x34 x35 x36 x37 x38 x39 x40))

;;; Names of input/output files and streams.
;;; 
(defvar *input-gra-file-name*)
(defvar *output-gra-file-name*)
(defvar *output-gra-file-stream*)

;;; The variable *global-variable-statements* contains a list
;;; of forms to be added at the top of each runtime linearizer file.
;;; 
(defvar *global-variable-statements*)
(setq *global-variable-statements* nil)



;;; ___________________________________________________________________
;;; 
;;; COMPTRF is the top-level function.  It reads ".gra" file
;;; and produces "_trf.lisp" file which implements the transformer.
;;; 
(defun comptrf (gra-file)
  
  (let ((rules nil))
	 
	; Initialize file names.
	; 
    (setq *input-gra-file-name* (concatenate 'string gra-file ".gra"))
    (setq *output-gra-file-name* (concatenate 'string gra-file "_trf.lisp"))
    (setq *output-gra-file-stream*
	   (open *output-gra-file-name* :direction :output
				        :if-exists :new-version))
    (setq *global-variable-statements* nil)
    
	; read input file (each rule is preprocessed) and
 	; make a hash table indexed by the lhs.
      	; READ-FILE-LIST defined in UTIL.			 
 	; 
  
       (format t "***** Start Writing ~S~%" *output-gra-file-name*)

	;	
 	; Write general statements to output file.
	; 
       (dolist (statement *global-variable-statements*)
	      (princ statement *output-gra-file-stream*)
      	      (terpri *output-gra-file-stream*))

       (setq rules (read-trf-file *input-gra-file-name*))
       (dolist (rule rules)
	  (comptrf-1 rule))

	; Close output file.
	; 
    (close *output-gra-file-stream*)
    (format t "***** End Writing ~S~%" *output-gra-file-name*)
    (format t "***** Start Loading ~S~%" *output-gra-file-name*)
    (load *output-gra-file-name*)
    (format t "***** End Loading ~S~%" *output-gra-file-name*)))
    

;;; ________________________________________________________________
;;;
;;;   TRF-RULE-PREPROCESS preprocesses one transformation rule.
;;;
(defun trf-rule-preprocess (rule)
  (cond
	   ;; If macro or function definition, do define.
	   ;;
        ((member (car rule) (list 'defmacro 'defun)) (eval rule) nil)

	   ;; Ignore @lex and @gra.			
	   ;;
	((member (car rule) (list '@lex '@gra)) 
	 nil)

           ;; If macro call, expand the macro.
	   ;;
        ((macro-function (car rule))
	 (mapcan #'trf-rule-preprocess (macroexpand rule)))

	   ;; Make sure that the rule is for parsing by looking at
	   ;; its arrow.  If so, return the rule (without arrow).
	   ;;
	((member (second rule) (list '<-- '<== '<==> '<--> '==> '-->))
	 (list rule))

	   ;; Otherwise, return nil.
	   ;;
        (t nil)))


;;;
;;; LOAD-TRF-FILES loads a list of files with "_trf.lisp" extention.
;;; 
(defun load-trf-files (file-list)
  (dolist (file file-list)
    (load (concatenate 'string file "trf.lisp"))))

;;; 
;;;    READ-TRF-FILE reads a grammar (list of rules), and
;;;    each rule is preprocessed.
;;; 
(defun read-trf-file (file)
 (let ((rule-list nil))
  (format t "***** Start Reading ~A~%" *input-gra-file-name*)
  (with-open-file (ifile file :direction :input)
    (do ((rule (read ifile nil '%eof%)(read ifile nil '%eof%)))
	((eq rule '%eof%))
      (setq rule-list (append rule-list (trf-rule-preprocess rule)))))
  (format t "***** End Reading ~A~%" *input-gra-file-name*)
  rule-list))


(defun comptrf-1 (rule)

  (let* ((lhs (first rule))
	 (arrow (second rule))
	 (rhs-list (third rule))
	 (rhs (if (atom rhs-list) (list rhs-list) rhs-list))
	 (statements (fourth rule))
	 (reg-list (subseq CONSTIT-LIST 1 (1+ (length rhs))))
	 (cons-list (mapcar #'(lambda (reg) `(list (quote ,reg) ,reg))
			      reg-list))
	 (fun-name (concatenate 'string
		      (symbol-name lhs)
		      (if (member arrow '(==> -->))
			   "-to-" "-from-")
		      (symbol-name (car rhs))))
	 (fun-body `(defun ,fun-name ,reg-list
		        (let ((x (list (list ,@cons-list))))
			    ,(compile-statements statements)
			    (getvalue* x '(x0))))))
    (princ fun-body *output-gra-file-stream*)
    (terpri *output-gra-file-stream*)))

